Shareware Grab Bag/Shareware Grab Bag.iso/090/byte0787.arc/BENCH.ADA

Text File | 1980-01-13 | 12.5 KB | 608 lines

The following benchmark listings accompany Namir Clement Shammas's review of four Ada compilers: Alsys/Ada, Artek Ada, Meridian Ada, and Janus Ada.

Listing 1.  Source code for Ada sieve benchmark program.

with TEXT_IO;
use TEXT_IO;

-- package INTIO is new INTEGER_IO(INTEGER);

PROCEDURE  MTSIE10 is

SIZE : constant INTEGER := 7000;

TYPE Flag_Array is array(0..SIZE) of BOOLEAN;

PRIME, K, COUNT : INTEGER;
FLAGS : Flag_Array;

BEGIN

    PUT_LINE("START TEN ITERATIONS");
    FOR ITER IN 1..10 LOOP
        COUNT := 0;

        FOR I IN 0..SIZE LOOP
            FLAGS(I) := TRUE;
        END LOOP;

        FOR I IN 0..SIZE LOOP

            IF FLAGS(I) THEN
                PRIME := I + I + 3;
                K := I + PRIME;

                WHILE K <= SIZE LOOP
                    FLAGS(K) := FALSE;
                    K := K + PRIME;
                END LOOP;

                COUNT := COUNT + 1;

            END IF;

        END LOOP;

    END LOOP;

    PUT(INTEGER'IMAGE(COUNT));
    PUT_LINE(" PRIMES");

END MTSIE10;


Listing 2.  Source code for Ada integer sort benchmark program.

with TEXT_IO;
use TEXT_IO;

Procedure MTSort2 is
-- Program will test the speed of sorting an integer array.
-- The program will create an array sorted from smaller to larger
-- integers, then sort them in the reverse order.
-- The array is reverse sorted ten times.

   package INTIO is new INTEGER_IO(INTEGER);

SIZE : constant := 1000;

TYPE NUMBERS is ARRAY(1..SIZE) OF INTEGER;

InOrder, AscendingOrder : BOOLEAN;
Offset, Temporary : INTEGER;
Ch : CHARACTER;
A : NUMBERS;

PROCEDURE InitializeArray is
-- Procedure to initialize array
BEGIN
    PUT_LINE("Initializing integer array");
    FOR I IN 1..SIZE LOOP
        A(I) := I;
    END LOOP;
END InitializeArray;

PROCEDURE ShellSort is
-- Procedure to perform a Shell-Meztner sorting

I : INTEGER;

    PROCEDURE SwapThem(I, J : in INTEGER) is
    -- Local procedure to swap elements A(I) and A(J)
    BEGIN
       InOrder := FALSE;
       Temporary := A(I);
       A(I) := A(J);
       A(J) := Temporary;
    END SwapThem;

BEGIN
   -- Toggle "AscendingOrder" flag status
       AscendingOrder := NOT AscendingOrder;
       Offset := SIZE;
       WHILE Offset > 1 LOOP
           Offset := Offset / 2;
           LOOP
               InOrder := TRUE;
               FOR J IN 1..(SIZE - Offset) LOOP
                   I := J + Offset;
                   IF AscendingOrder
                       THEN IF A(I) < A(J) THEN SwapThem(I,J); END IF;
                       ELSE IF A(I) > A(J) THEN SwapThem(I,J); END IF;
                   END IF; -- AscendingOrder
               END LOOP;
               IF InOrder THEN EXIT; END IF;
           END LOOP;
       END LOOP;
END ShellSort;

PROCEDURE DisplayArray is
-- Display array members
BEGIN
    FOR I IN 1..SIZE LOOP
        INTIO.PUT(A(I),3);
        PUT("  ");
    END LOOP;
    NEW_LINE;
END DisplayArray;

BEGIN -- Main
    InitializeArray;
    AscendingOrder := TRUE;
    PUT("Beginning to sort press <cr> "); GET(Ch); NEW_LINE;
    FOR Iter IN 1..10  LOOP
       PUT(".");
       ShellSort;
    END LOOP;
    PUT_LINE("Finished sorting!");
    DisplayArray;
END MTSort2;

Listing 3.  Source code for Ada basic floating benchmark program.

WITH TEXT_IO; USE TEXT_IO;
PROCEDURE MTFLOAT is

PACKAGE RealInOut is new FLOAT_IO(FLOAT);
USE RealInOut;

NR : CONSTANT INTEGER := 5000;

A, B, C : FLOAT;

BEGIN
    A := 2.71828;
    B := 3.1459;
    C := 1.0;

    FOR I IN 1..NR LOOP
        C := C * A;
        C := C * B;
        C := C / A;
        C := C / B;
    END LOOP;

    PUT("DONE");
    NEW_LINE;
    PUT("ERROR = ");
    PUT((C-1.0));
    NEW_LINE;
END MTFLOAT;

Listing 4.  Source code for Ada matrix inversion floating benchmark program.

with TEXT_IO;
use TEXT_IO;

Procedure MTINVERT is

-- Program to test speed of floating point matrix inversion.
-- The program will form a matrix with ones' in every member,
-- except the diagonals which will have values of 2.

  package RealInOut is new FLOAT_IO(FLOAT);

  MAX : constant := 20;

  TYPE MATRIX is ARRAY (1..MAX,1..MAX) OF FLOAT;

  J, K, L: INTEGER;
  DET, PIVOT, TEMPO: FLOAT;
  A: MATRIX;

Procedure Invert is

 BEGIN

 -- Creating test matrix

  FOR J IN 1..MAX LOOP

    FOR K IN 1..MAX LOOP

      A(J, K) := 1.0;

    END LOOP;

    A(J, J) := 2.0;

  END LOOP;


  PUT_LINE("Starting matrix invertion");


  DET := 1.0;

  FOR J IN 1..MAX LOOP

    PIVOT := A(J, J);
    DET := DET*PIVOT;
    A(J, J) := 1.0;

    FOR K IN 1..MAX LOOP

      A(J, K) := A(J, K) / PIVOT;

    END LOOP;

    FOR K IN 1..MAX LOOP

      IF K /= J THEN

        TEMPO := A(K, J);
        A(K, J) := 0.0;

        FOR L IN 1..MAX LOOP

          A(K, L) := A(K, L) - A(J, L) * TEMPO;

        END LOOP;

      END IF;

    END LOOP;

  END LOOP;

 END Invert;

BEGIN

  NEW_LINE(2);
  Invert;
  PUT("Determinant = ");
  RealInOut.PUT(DET,14,10);
  NEW_LINE(2);

END MTINVERT;

Listing 5.  Source code for Ada math functions benchmark program.

-- use Janus/Ada libraries
WITH TEXT_IO; WITH SMATHLIB;
USE TEXT_IO; USE SMATHLIB;

PROCEDURE MTMath is

-- Program tests the speed of math function.
-- Each function is timed separately.
-- Functions are shown in the import list


pi, angle, result, argument: FLOAT;
dummy: CHARACTER;

BEGIN
  PUT_LINE("START SQUARE ROOT TEST");
  PUT("PRESS <CR> TO START");
  GET(dummy); New_Line;

  FOR i in 1..10 LOOP
    PUT(".");
    argument := 0.0;
    WHILE argument <= 1000.0 LOOP
      result := Sqrt(argument);
      argument := argument + 1.0;
    END LOOP;
  END LOOP;

  New_Line; PUT("END OF SQUARE ROOT TEST"); New_Line;

  PUT("START LOG TEST");
  New_Line;
  PUT("PRESS <CR> TO START");
  GET(dummy); New_Line;

  FOR i in 1..10 LOOP
    PUT(".");
    argument := 0.1;
    WHILE argument <= 1000.1 LOOP
      result := Log(argument);
      argument := argument + 1.0;
    END LOOP;
  END LOOP;

  New_Line; PUT("END OF LOG TEST"); New_Line;

  PUT("START EXPONENTIAL TEST");
  New_Line;
  PUT("PRESS <CR> TO START");
  GET(dummy); New_Line;

  FOR i in 1..10 LOOP
    PUT(".");
    argument := 0.1;
    WHILE argument <= 10.0 LOOP
      result := exp(argument);
      argument := argument + 0.01;
    END LOOP;
  END LOOP;

  New_Line; PUT("END OF EXPONENTIAL TEST"); New_Line;

  PUT("START ARCTANGENT TEST");
  New_Line;
  PUT("PRESS <CR> TO START");
  GET(dummy); New_Line;

  FOR i in 1..10 LOOP
    PUT(".");
    argument := 0.1;
    WHILE argument <= 10.0 LOOP
      angle := arctan(argument);
      argument := argument + 0.01;
    END LOOP;
  END LOOP;

  New_Line; PUT("END OF ARCTANGENT TEST"); New_Line;


  pi := 355.0 / 113.0;
  PUT("START SINE TEST");
  New_Line;
  PUT("PRESS <CR> TO START");
  GET(dummy); New_Line;

  FOR i in 1..10 LOOP
    PUT(".");
    angle := 0.0;
    WHILE angle <= 2.0 * pi LOOP
      result := sin(angle);
      angle := angle + pi / 360.0;
    END LOOP;
  END LOOP;

  New_Line; PUT("END OF SINE TEST"); New_Line;
  New_Line;
  PUT("DONE"); New_Line; New_Line;

END MTMath;

Listing 6.  Source code for Ada recursion benchmark program.

with TEXT_IO;
use TEXT_IO;

Procedure MTQSort is

-- The test uses QuickSort to measure recursion speed
-- An ordered array is created by the program and is
-- reverse sorted.  The process is performed "MAXITER"
-- number of times.

package Int_IO is new INTEGER_IO(INTEGER);

SIZE : constant := 1000;
MAXITER : constant := 10;
WantToListArray : constant BOOLEAN := FALSE; -- Flag used for debugging

TYPE Numbers is ARRAY(1..SIZE) OF INTEGER;

A : Numbers;

PROCEDURE InitializeArray is
-- Procedure to initialize array

BEGIN
    FOR I in 1..SIZE LOOP
        A(I) := SIZE - I + 1;
    END LOOP;
    NEW_LINE(3);
END InitializeArray;

PROCEDURE QuickSort is
-- Procedure to perform a QuickSort

PROCEDURE Sort(Left, Right : INTEGER) is

i, j : INTEGER;
Data1, Data2 : INTEGER;

BEGIN
    i := Left; j := Right;
    Data1 := A((Left + Right) / 2);
    LOOP
        WHILE A(i) < Data1 LOOP i := i + 1; END LOOP;
        WHILE Data1 < A(j) LOOP j := j - 1; END LOOP;
        IF i <= j THEN
            Data2 := A(i); A(i) := A(j); A(j) := Data2;
            i := i + 1;
            j := j - 1;
        END IF;
        IF i > j THEN EXIT; END IF;
    END LOOP;
    IF Left < j  THEN Sort(Left,j);  END IF;
    IF i < Right THEN Sort(i,Right); END IF;
END Sort;

BEGIN
    Sort(1,SIZE);
END QuickSort;

PROCEDURE DisplayArray is
-- Display array members
BEGIN
    FOR I in 1..SIZE LOOP
        Int_IO.PUT(A(I),4);
        PUT("  ");
    END LOOP;
    NEW_LINE;
END DisplayArray;

BEGIN -- Main
    FOR Iter in 1..MAXITER  LOOP
       InitializeArray;
       PUT(".");
       QuickSort;
    END LOOP;
    NEW_LINE;
    PUT_LINE("Finished sorting!");
    IF WantToListArray THEN DisplayArray; END IF;
END MTQSort;

Listing 7.  Source code for Ada dynamic allocation benchmark program.


with TEXT_IO;
use TEXT_IO;

PROCEDURE MTPtr is

-----------------------------------------------
-- Program to measure the speed of:
--
-- 1) Allocating dynamic binary-tree structure
--
-- 2) Searching through the binary-tree
-----------------------------------------------


SIZE : constant INTEGER := 1000;
MainLoopCount : constant INTEGER := 200;

TYPE Node;

TYPE Ptr is access Node;

TYPE Node is record
              Value : INTEGER;
              Left, Right : Ptr;
            end record;

TYPE NumbersArray is ARRAY (1..SIZE) OF INTEGER;

Numbers : NumbersArray;
TreeRoot : Ptr;
dummy : CHARACTER;


PROCEDURE Create is

J : INTEGER := 1;

BEGIN

    WHILE J <= SIZE LOOP
        IF (J >= 1) AND (J < 251) THEN
           Numbers(J) := J;
        ELSIF (J > 250) AND (J < 501) THEN
           Numbers(J) := SIZE - J;
        ELSIF (J > 500) AND (J < 750) THEN
           Numbers(J) := J;
        ELSE
           Numbers(J) := SIZE - J;
        END IF;
        J := J + 1;
        PUT(INTEGER'IMAGE(J) & "  ");
    END LOOP;
    new_line;
END Create;

PROCEDURE Insert(Root : in out Ptr; Item : INTEGER) is
-- Insert element in binary-tree
BEGIN
    IF Root = null THEN
        Root := new Node;
        Root.Value := Item;
        Root.Left := null;
        Root.Right := null;
    ELSE
        IF Item < Root.Value THEN Insert(Root.Left,Item);
                             ELSE Insert(Root.Right,Item);
        END IF;
    END IF;
END Insert;


PROCEDURE Search(Root : in out Ptr; Target : INTEGER) is
-- Recursive procedure to search for Target value
BEGIN
    IF not (Root = null) THEN
        IF not (Target = Root.Value) THEN
            IF Target < Root.Value THEN
                Root := Root.Left; Search(Root,Target);
            ELSE
                Root := Root.Right;
                Search(Root,Target);
            END IF;
        END IF;
    END IF;
END Search;

BEGIN -- MAIN
    Create;
    PUT_LINE("Created array");
    -- Building the binary tree
    PUT("Press <CR> to time tree creation ");
    GET(dummy); NEW_LINE;
    TreeRoot := null;
    FOR I IN 1..SIZE LOOP
       Insert(TreeRoot,Numbers(I));
    END LOOP;
    NEW_LINE;
    PUT_LINE("Created Tree");
    PUT("Press <CR> to time tree search ");
    GET(dummy); NEW_LINE;
    FOR Iter IN 1..MainLoopCount LOOP
        FOR I IN reverse 1..SIZE LOOP
            Search(TreeRoot,Numbers(I));
        END LOOP;
    END LOOP;
    NEW_LINE;
    PUT_LINE("DONE");
END MTPtr;

Listing 8.  Source code for Ada disk-write benchmark program.

with TEXT_IO;
use TEXT_IO;

Procedure MTWRITE is

Num_Rec : constant := 512;

Small : STRING(1..30);
Big : STRING(1..120);
F : FILE_TYPE;

BEGIN
   Small(1..30) := "123456781234567812345678123456";
   Big := Small & Small & Small & Small;

   CREATE(F, OUT_FILE, "A:TEMPO.DAT");

   FOR I in 1..Num_Rec LOOP
       PUT_LINE(F, Big);
   END LOOP;

   CLOSE(F);
   PUT_LINE("DONE");

END MTWRITE;

Listing 9.  Source code for Ada disk-read benchmark program.

with TEXT_IO;
use TEXT_IO;

Procedure MTREAD is

Num_Rec : constant := 512;

Big : STRING(1..120);
Last : NATURAL;
F : FILE_TYPE;

BEGIN

   OPEN(F, IN_FILE, "A:TEMPO.DAT");

   FOR I in 1..Num_Rec LOOP
      GET_LINE(F, Big, Last);
   END LOOP;
   CLOSE(F);
   PUT_LINE("DONE");
END MTREAD;